(* Copyright (C) 2010 School of Software Engineering, 
 * University of Science and Technology of China.
 *
 * This code is released under a BSD-style license.
 * See the file LICENSE for details.
 *)

structure CommandArg: COMMAND_ARG =
struct

exception BadOption of string

datatype t
  = Yes of string list
  | No of string

val opts =
    List.map 
        (fn (level, name, arg, desc, action) => 
            {level = level, name = name, arg = arg, desc = desc, action = action})
        [(Control.Advanced, "-expert", " {t|f}", "show advanced options",
          Control.String (fn "f" => Control.expert := false
                           | "t" => Control.expert := true
                           | _ => raise BadOption "-expert wants {t|f}")),
         (Control.Normal, "-keep", " {t|f}", "whether or not to keep intermediate files",
          Control.String (fn "f" => Control.keepFile := false
                           | "t" => Control.keepFile := true
                           | _ => raise BadOption "-keep wants {t|f}")),
         (Control.Advanced, "-trace", " name", "trace execution of function name",
          Control.String (fn x => Trace.enter x)),
         (Control.Normal, "-verbose", " {0|1|2|3}", "how verbose to be",
          Control.String (fn "0" => Control.verbose := Control.L0
                           | "1" => Control.verbose := Control.L1
                           | "2" => Control.verbose := Control.L2
                           | "3" => Control.verbose := Control.L3
                           | _ => raise BadOption "-verbose wants {0|1|2|3}"))]

fun cookArgs2 (args, options) =
    let fun apply1 (f, rem, name) =
            case rem
             of [] => raise BadOption (String.concat [name, " wants an arg"])
              | x::xs => (f x; xs)
        fun search (x, rem) =
            let val rec doit =
                 fn [] => raise BadOption (String.concat ["unknown option: ", x])
                  | {name, action = Control.String f, level, arg, desc}::xs =>
                    if x=name
                    then apply1 (f, rem, name)
                    else doit xs
            in  doit options
            end
        val rec doit =
         fn ([], rem) => List.rev rem
          | (x::xs, rem) =>
            if String.isPrefix "-" x
            then doit (search (x, xs), rem)
            else doit (xs, x::rem)
    in  doit (args, [])
    end

fun cook (args) =
    let fun printOptions () =
            let val table = Table.new [Table.Left, Table.Left, Table.Left]
                fun doit (list, table) =
                    case list
                     of [] => table
                      | {name, arg, desc, action, level}::xs =>
                        (case (level, !Control.expert)
                          of (Control.Normal, _) => 
                             doit (xs, Table.insertLine 
                                           (table, ["   "^name^arg, " ", desc]))
                           | (Control.Advanced, true) =>
                             doit (xs, Table.insertLine 
                                           (table, ["   "^name^arg, " ", desc]))
                           | _ => doit (xs, table))
                val table = doit (opts, table)
                val _ = print "valid options:\n"
                val _ = Table.output (Table.rev table)
            in  ()
            end
        val args = Yes (cookArgs2 (args, opts))
            handle BadOption s => (print s
                                 ; print "\n"
                                 ; printOptions ()
                                 ; No "")                   
    in  args
    end

end
